home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / Gimp / Pod.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-14  |  3.6 KB  |  176 lines
  1. package Gimp::Pod;
  2.  
  3. $VERSION=1.211;
  4.  
  5. sub myqx(&) {
  6.    local $/;
  7.    local *MYQX;
  8.    if (0==open MYQX,"-|") {
  9.       &{$_[0]};
  10.       close STDOUT;
  11.       Gimp::_exit;
  12.    }
  13.    <MYQX>;
  14. }
  15.  
  16. sub find_converters {
  17.    my $path = eval 'use Config; $Config{installscript}';
  18.  
  19.    if ($] < 5.00558) {
  20.       $converter{text} = sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000,       $pod) } };
  21.       $converter{texta}= sub { my $pod=shift; require Pod::Text; myqx { Pod::Text::pod2text (-60000, '-a', $pod) } };
  22.    } else {
  23.       $converter{text} = sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
  24.       $converter{texta}= sub { qx($path/pod2text $_[0]) } if -x "$path/pod2text" ;
  25.    }
  26.    $converter{html} = sub { my $pod=shift; require Pod::Html; myqx { Pod::Html::pod2html ($pod) } };
  27.    $converter{man}  = sub { qx($path/pod2man   $_[0]) } if -x "$path/pod2man" ;
  28.    $converter{latex}= sub { qx($path/pod2latex $_[0]) } if -x "$path/pod2latex" ;
  29. }
  30.  
  31. sub find {
  32.    -f $0 ? $0 : ();
  33. }
  34.  
  35. sub new {
  36.    my $pkg = shift;
  37.    my $self={};
  38.    return () unless defined($self->{path}=find);
  39.    bless $self, $pkg;
  40. }
  41.  
  42. sub _cache {
  43.    my $self = shift;
  44.    my $fmt = shift;
  45.    if (!$self->{doc}{$fmt} && $converter{$fmt}) {
  46.       local $^W = 0;
  47.       my $doc = $converter{$fmt}->($self->{path});
  48.       undef $doc if $?>>8;
  49.       undef $doc if $doc=~/^[ \t\r\n]*$/;
  50.       $self->{doc}{$fmt}=\$doc;
  51.    }
  52.    $self->{doc}{$fmt};
  53. }
  54.  
  55. sub format {
  56.    my $self = shift;
  57.    my $fmt = shift || 'text';
  58.    ${$self->_cache($fmt)};
  59. }
  60.  
  61. sub sections {
  62.    my $self = shift;
  63.    my $doc = $self->_cache('text');
  64.    $$doc =~ /^\S.*$/mg;
  65. }
  66.  
  67. sub section {
  68.    my $self = shift;
  69.    my $doc = $self->_cache('text');
  70.    if (defined $$doc) {
  71.       ($doc) = $$doc =~ /^$_[0]$(.*?)(?:^[A-Z]|$)/sm;
  72.       if ($doc) {
  73.          $doc =~ y/\r//d;
  74.          $doc =~ s/^\s*\n//;
  75.          $doc =~ s/[ \t\r\n]+$/\n/;
  76.          $doc =~ s/^    //mg;
  77.       }
  78.       $doc;
  79.    } else {
  80.       ();
  81.    }
  82. }
  83.  
  84. sub author {
  85.    my $self = shift;
  86.    $self->section('AUTHOR');
  87. }
  88.  
  89. sub blurb {
  90.    my $self = shift;
  91.    $self->section('BLURB') || $self->section('NAME');
  92. }
  93.  
  94. sub description {
  95.    my $self = shift;
  96.    $self->section('DESCRIPTION');
  97. }
  98.  
  99. sub copyright {
  100.    my $self = shift;
  101.    $self->section('COPYRIGHT') || $self->section('AUTHOR');
  102. }
  103.  
  104. find_converters;
  105.  
  106. 1;
  107. __END__
  108.  
  109. =head1 NAME
  110.  
  111. Gimp::Pod - Evaluate pod documentation embedded in scripts.
  112.  
  113. =head1 SYNOPSIS
  114.  
  115.   use Gimp::Pod;
  116.  
  117.   $pod = new Gimp::Pod;
  118.   $text = $pod->format ();
  119.   $html = $pod->format ('html');
  120.   $synopsis = $pod->section ('SYNOPSIS');
  121.   $author = $pod->author;
  122.   @sections = $pod->sections;
  123.  
  124. =head1 DESCRIPTION
  125.  
  126. C<Gimp::Pod> can be used to find and parse embedded pod documentation in
  127. gimp-perl scripts.  At the moment only the formatted text can be fetched,
  128. future versions might have more interesting features.
  129.  
  130. =head1 METHODS
  131.  
  132. =over 4
  133.  
  134. =item new
  135.  
  136. return a new Gimp::Pod object representing the current script or undef, if
  137. an error occured.
  138.  
  139. =item format([$format])
  140.  
  141. Returns the embedded pod documentation in the given format, or undef if no
  142. documentation can be found.  Format can be one of 'text', 'html', 'man' or
  143. 'latex'. If none is specified, 'text' is assumed.
  144.  
  145. =item section($header)
  146.  
  147. Tries to retrieve the section with the header C<$header>. There is no
  148. trailing newline on the returned string, which may be undef in case the
  149. section can't be found.
  150.  
  151. =item author
  152.  
  153. =item blurb
  154.  
  155. =item description
  156.  
  157. =item copyright
  158.  
  159. Tries to retrieve fields suitable for calls to the register function.
  160.  
  161. =item sections
  162.  
  163. Returns a list of paragraphs found in the pod.
  164.  
  165. =back
  166.  
  167. =head1 AUTHOR
  168.  
  169. Marc Lehmann <pcg@goof.com>
  170.  
  171. =head1 SEE ALSO
  172.  
  173. perl(1), Gimp(1),
  174.  
  175. =cut
  176.